home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / glass / glass.lha / GLASS / tmc / cll.ct < prev    next >
Text File  |  1990-11-06  |  20KB  |  958 lines
  1. /* 
  2.    Copyright (C) 1990 C van Reewijk, email: dutentb.uucp!reeuwijk
  3.  
  4. This file is part of GLASS.
  5.  
  6. GLASS is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GLASS is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GLASS; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. .. file: cll.ct
  21. ..
  22. .. The following variables must be set in tm:
  23. .. basename:     the name of the module. used to generate stat_..
  24. .. wantdefs:     the names of wanted definitions.
  25. ..
  26. .error Warning: 'cll' library is obsolete, use 'cllu' library.
  27. .error 'cll' does not support reading of NIL pointers.
  28. /* ---- start of ${tplfilename} ---- */
  29.  
  30. /* routines for $(basename).
  31.  
  32.    template file:      ${tplfilename}
  33.    datastructure file: ${dsfilename}
  34.    tm version:         $(tmvers) ($(tmdate))
  35.  
  36.    The following C pre-processor variables may be defined:
  37. .if ${index stat_$(basename) $(need_misc)}
  38.    STAT          If you want code for statistics.
  39.          Statistics are written to 'FILE *statstream'.
  40. .endif
  41.    FATAL(msg)    If you want supply a fatal error handler to print 'msg'.
  42.          A default is provided.
  43.   
  44.    Possible declaration or #define'ing of statstream
  45.    must be done outside this module.
  46.  */
  47.  
  48. /* used UNIX functions */
  49. extern char *malloc();
  50. extern char *realloc();
  51.  
  52. #ifndef WORDBUFSIZE
  53. #define WORDBUFSIZE 100
  54. #endif
  55.  
  56. .if ${index stat_$(basename) $(need_misc)}
  57. #ifdef STAT
  58. static char tm_allocfreed[] = "%-15s: %6ld allocated, %6ld freed.%s\n";
  59. #endif
  60. .endif
  61.  
  62. static char *tm_srcfile = __FILE__;
  63.  
  64. .if ${len $(need_print) $(need_print_list) $(need_fprint) $(need_fprint_list)}
  65. static char tm_niltxt[] = "@";
  66.  
  67. .endif
  68. #ifndef FATAL
  69. #define FATAL(msg) tmfatal(tm_srcfile,__LINE__,msg)
  70. #endif
  71.  
  72. /* the possible error messages */
  73. static char tm_outofmemory[] = "out of memory";
  74.  
  75. .if ${len $(need_fscan_list)}
  76. static char tm_badeof[] = "unexpected end of file";
  77. .endif
  78. .if ${len $(need_fscan)}
  79. static char tm_badcons[] = "bad constructor for %s: '%s'";
  80. .endif
  81.  
  82. #ifndef FATALTAG
  83. #define FATALTAG(tg) tmbadtag(tm_srcfile,__LINE__,tg)
  84. #endif
  85.  
  86. .if ${index stat_$(basename) $(need_misc)}
  87. #ifdef STAT
  88. .foreach t $(need_stat)
  89. .if ${len ${telmlist $t}}
  90. static long int newcnt_$t = 0, frecnt_$t = 0;
  91. .else
  92. .foreach c ${conslist $t}
  93. static long int newcnt_$c = 0, frecnt_$c = 0;
  94. .endforeach
  95. .endif
  96. .endforeach
  97. #endif
  98. .endif
  99.  
  100. /************************************************
  101.  *    new_<cons> routines                       *
  102.  ************************************************/
  103.  
  104. .foreach t $(need_new)
  105. .if ${index $t $(want_new)}
  106. .set stat
  107. .else
  108. .set stat "static "
  109. .endif
  110. .if ${len ${telmlist $t}}
  111. /* Allocate a new instance of tuple type '$t' */
  112. $(stat)$t new_$t( ${seplist ", " ${prefix "par_" ${telmlist $t}}} )
  113. .foreach sname ${telmlist $t}
  114. .if ${eq list ${ttypeclass $t $(sname)}}
  115.  ${ttypename $t $(sname)}_list par_$(sname);
  116. .else
  117.  ${ttypename $t $(sname)} par_$(sname);
  118. .endif
  119. .endforeach
  120. {
  121.     $t new;
  122.  
  123.     new = ($t) malloc( sizeof(*new));
  124.     if( (char *)new == (char *)0 ){
  125.         FATAL( tm_outofmemory );
  126.     }
  127.     new->next = $tNIL;
  128. .foreach sname ${telmlist $t}
  129.     new->$(sname) = par_$(sname);
  130. .endforeach
  131. .if ${index stat_$(basename) $(need_misc)}
  132. #ifdef STAT
  133.     newcnt_$t++;
  134. #endif
  135. .endif
  136.     return new;
  137. }
  138. .else
  139. .foreach c ${conslist $t}
  140. /* Allocate a new instance of constructor '$c' */
  141. $(stat)$t new_$c( ${seplist ", " ${prefix "par_" ${celmlist $t $c}}} )
  142. .foreach sname ${celmlist $t $c}
  143. .if ${eq list ${ctypeclass $t $c $(sname)}}
  144.  ${ctypename $t $c $(sname)}_list par_$(sname);
  145. .else
  146.  ${ctypename $t $c $(sname)} par_$(sname);
  147. .endif
  148. .endforeach
  149. {
  150.     register $c new;
  151.  
  152.     new = ($c) malloc( sizeof(*new));
  153.     if( (char *)new == (char *)0 ){
  154.         FATAL( tm_outofmemory );
  155.     }
  156.     new->next = $tNIL;
  157.     new->tag = TAG$c;
  158. .foreach sname ${celmlist $t $c}
  159.     new->$(sname) = par_$(sname);
  160. .endforeach
  161. .if ${index stat_$(basename) $(need_misc)}
  162. #ifdef STAT
  163.     newcnt_$c++;
  164. #endif
  165. .endif
  166.     return ($t) new;
  167. }
  168.  
  169. .endforeach
  170. .endif
  171. .endforeach
  172. /**********************************************************
  173.  *    fre_<type> and fre_<type>_list routines             *
  174.  **********************************************************/
  175.  
  176. .foreach t $(need_fre)
  177. .if ${index $t $(want_fre)}
  178. .set stat
  179. .else
  180. .set stat "static "
  181. .endif
  182. /* free an element of type $t */
  183. $(stat)void fre_$t( e )
  184.  $t e;
  185. {
  186.     if( e == $tNIL ) return;
  187.     free( (char *) e );
  188. .if ${len ${telmlist $t}}
  189. .if ${index stat_$(basename) $(need_misc)}
  190. #ifdef STAT
  191.     frecnt_$t++;
  192. #endif
  193. .endif
  194. .else
  195. .if ${index stat_$(basename) $(need_misc)}
  196. #ifdef STAT
  197.     switch( e->tag ){
  198. .foreach c ${conslist $t}
  199.         case TAG$c:
  200.             frecnt_$c++;
  201.             break;
  202.  
  203. .endforeach
  204.         default:
  205.             FATALTAG( e->tag );
  206.     }
  207. #endif
  208. .endif
  209. .endif
  210. }
  211.  
  212. .endforeach
  213. .foreach t $(need_fre_list)
  214. .if ${index $t $(want_fre_list)}
  215. .set stat
  216. .else
  217. .set stat "static "
  218. .endif
  219. /* free a list of $t elements */
  220. $(stat)void fre_$t_list( e )
  221.  register $t_list e;
  222. {
  223.     register $t_list n;
  224.  
  225.     while( e!=$tNIL ){
  226.         n = e->next;
  227.         fre_$t( e );
  228.         e = n;
  229.     }
  230. }
  231.  
  232. .endforeach
  233. /**********************************************************
  234.  *    rfre_<type> and rfre_<type>_list routines           *
  235.  **********************************************************/
  236. .. forward declarations
  237. .foreach t $(need_rfre)
  238. .if ${index $t $(want_rfre)}
  239. .else
  240. static void rfre_$t();
  241. .endif
  242. .endforeach
  243. .foreach t $(need_rfre_list)
  244. .if ${index $t $(want_rfre_list)}
  245. .else
  246. static void rfre_$t_list();
  247. .endif
  248. .endforeach
  249.  
  250. .foreach t $(need_rfre)
  251. .if ${index $t $(want_rfre)}
  252. .set stat
  253. .else
  254. .set stat "static "
  255. .endif
  256. /* Recursively free an element of type '$t'
  257.    and all elements in it.
  258.  */
  259. $(stat)void rfre_$t( e )
  260.  $t e;
  261. {
  262. .if ${len ${telmlist $t}}
  263.     if( e == $tNIL ) return;
  264. .foreach sname ${telmlist $t}
  265. .if ${eq list ${ttypeclass $t $(sname)}}
  266.     rfre_${ttypename $t $(sname)}_list( e->$(sname) );
  267. .else
  268.     rfre_${ttypename $t $(sname)}( e->$(sname) );
  269. .endif
  270. .endforeach
  271. .else
  272.     if( e == $tNIL ) return;
  273.     switch( e->tag ){
  274. .foreach c ${conslist $t}
  275.         case TAG$c:
  276. .foreach sname ${celmlist $t $c}
  277. .if ${eq list ${ctypeclass $t $c $(sname)}}
  278.             rfre_${ctypename $t $c $(sname)}_list( (($c) e)->$(sname) );
  279. .else
  280.             rfre_${ctypename $t $c $(sname)}( (($c) e)->$(sname) );
  281. .endif
  282. .endforeach
  283.             break;
  284.  
  285. .endforeach
  286.         default:
  287.             FATALTAG( e->tag );
  288.     }
  289. .endif
  290.     fre_$t( e );
  291. }
  292.  
  293. .endforeach
  294. .foreach t $(need_rfre_list)
  295. .if ${index $t $(want_rfre_list)}
  296. .set stat
  297. .else
  298. .set stat "static "
  299. .endif
  300. /* recursively free a list of elements of type $t */
  301. $(stat)void rfre_$t_list( e )
  302.  register $t_list e;
  303. {
  304.     register $t n;
  305.  
  306.     while( e!=$tNIL ){
  307.         n = e->next;
  308.         rfre_$t( e );
  309.         e = n;
  310.     }
  311. }
  312.  
  313. .endforeach
  314. /**********************************************************
  315.  *    app_<type>_list routines                            *
  316.  **********************************************************/
  317.  
  318. .foreach t $(need_app_list)
  319. .if ${index $t $(want_app_list)}
  320. .set stat
  321. .else
  322. .set stat "static "
  323. .endif
  324. /* append list of $t 'b' after list of $t 'a' */
  325. $(stat)$t app_$t_list( a, b )
  326.  $t_list a;
  327.  $t b;
  328. {
  329.     register $t tl;
  330.  
  331.     if( a == $tNIL ) return b;
  332.     tl = a;
  333.     while( tl->next != $tNIL ) tl = tl->next;
  334.     tl->next = b;
  335.     return a;
  336. }
  337.  
  338. .endforeach
  339. /******************************************************
  340.  *    print_<type> and print_<type>_list routines     *
  341.  ******************************************************/
  342. .. Forward declarations
  343. .foreach t $(need_print)
  344. .if ${index $t $(want_print)}
  345. .else
  346. static void print_$t();
  347. .endif
  348. .endforeach
  349. .foreach t $(need_print_list)
  350. .if ${index $t $(want_print_list)}
  351. .else
  352. static void print_$t_list();
  353. .endif
  354. .endforeach
  355.  
  356. .foreach t $(need_print)
  357. .if ${index $t $(want_print)}
  358. .set stat
  359. .else
  360. .set stat "static "
  361. .endif
  362. /* Print an element of type '$t'
  363.  * using print optimization routines.
  364.  */
  365. $(stat)void print_$t( t )
  366.  $t t;
  367. {
  368.     if( t==$tNIL ){
  369.         printword( tm_niltxt );
  370.         return;
  371.     }
  372. .if ${len ${telmlist $t}}
  373.     opentuple();
  374. .foreach sname ${telmlist $t}
  375. .if ${eq list ${ttypeclass $t $(sname)}}
  376.     print_${ttypename $t $(sname)}_list( t->$(sname) );
  377. .else
  378.     print_${ttypename $t $(sname)}( t->$(sname) );
  379. .endif
  380. .endforeach
  381.     closetuple();
  382. .else
  383.     opencons();
  384.     switch( t->tag ){
  385. .foreach c ${conslist $t}
  386.         case TAG$c:
  387.             printword( "$c" );
  388. .foreach sname ${celmlist $t $c}
  389. .if ${eq list ${ctypeclass $t $c $(sname)}}
  390.             print_${ctypename $t $c $(sname)}_list( (($c) t)->$(sname) );
  391. .else
  392.             print_${ctypename $t $c $(sname)}( (($c) t)->$(sname) );
  393. .endif
  394. .endforeach
  395.             break;
  396.  
  397. .endforeach
  398.         default:
  399.             FATALTAG( t->tag );
  400.     }
  401.     closecons();
  402. .endif
  403. }
  404.  
  405. .endforeach
  406. .foreach t $(need_print_list)
  407. .if ${index $t $(want_print_list)}
  408. .set stat
  409. .else
  410. .set stat "static "
  411. .endif
  412. /* Print list of elements of type '$t'
  413.  * using print optimization routines.
  414.  */
  415. $(stat)void print_$t_list( l )
  416.  $t_list l;
  417. {
  418.     openlist();
  419.     while( l!=$tNIL ){
  420.         print_$t( l );
  421.         l=l->next;
  422.     }
  423.     closelist();
  424. }
  425.  
  426. .endforeach
  427. /*********************************************************
  428.  *    fprint_<type> and fprint_<type>_list routines      *
  429.  *********************************************************/
  430.  
  431. .. Forward declarations
  432. .foreach t $(need_fprint)
  433. .if ${index $t $(want_fprint)}
  434. .else
  435. static void fprint_$t();
  436. .endif
  437. .endforeach
  438. .foreach t $(need_fprint_list)
  439. .if ${index $t $(want_fprint_list)}
  440. .else
  441. static void fprint_$t_list();
  442. .endif
  443. .endforeach
  444.  
  445. .foreach t $(need_fprint)
  446. .if ${index $t $(want_fprint)}
  447. .set stat
  448. .else
  449. .set stat "static "
  450. .endif
  451. /* Print an element of type '$t' to file 'f' */
  452. $(stat)void fprint_$t( f, t )
  453.  FILE *f;
  454.  $t t;
  455. {
  456.     if( t==$tNIL ){
  457.         fprintf( f, tm_niltxt );
  458.         return;
  459.     }
  460. .if ${len ${telmlist $t}}
  461.     putc( '(', f );
  462. .set first 1
  463. .foreach sname ${telmlist $t}
  464. .if $(first)
  465. .set first 0
  466. .else
  467.     putc( ',', f );
  468. .endif
  469. .if ${eq list ${ttypeclass $t $(sname)}}
  470.     fprint_${ttypename $t $(sname)}_list( f, t->$(sname) );
  471. .else
  472.     fprint_${ttypename $t $(sname)}( f, t->$(sname) );
  473. .endif
  474. .endforeach
  475.     fputs( ")\n", f );
  476. .else
  477.     putc( '(', f );
  478.     switch( t->tag ){
  479. .foreach c ${conslist $t}
  480.         case TAG$c:
  481.             fputs( "$c", f );
  482. .foreach sname ${celmlist $t $c}
  483.             putc( ' ', f );
  484. .if ${eq list ${ctypeclass $t $c $(sname)}}
  485.             fprint_${ctypename $t $c $(sname)}_list( f, (($c) t)->$(sname) );
  486. .else
  487.             fprint_${ctypename $t $c $(sname)}( f, (($c) t)->$(sname) );
  488. .endif
  489. .endforeach
  490.             break;
  491.  
  492. .endforeach
  493.         default:
  494.             FATALTAG( t->tag );
  495.     }
  496.     fputs( ")\n", f );
  497. .endif 
  498. }
  499.  
  500. .endforeach
  501. .foreach t $(need_fprint_list)
  502. .if ${index $t $(want_fprint_list)}
  503. .set stat
  504. .else
  505. .set stat "static "
  506. .endif
  507. /* Print list of elements of type '$t' to file 'f' */
  508. $(stat)void fprint_$t_list( f, l )
  509.  FILE *f;
  510.  $t_list l;
  511. {
  512.     putc( '[', f );
  513.     while( l!=$t_listNIL ){
  514.         fprint_$t( f, l );
  515.         l=l->next;
  516.         if( l!=$tNIL ){
  517.             putc( ',', f );
  518.         }
  519.     }
  520.     fputs( "]\n", f );
  521. }
  522.  
  523. .endforeach
  524. /*********************************************************
  525.  *    rdup_<type> and rdup_<type>_list routines          *
  526.  *********************************************************/
  527.  
  528. .. forward declarations
  529. .foreach t $(need_rdup)
  530. .if ${index $t $(want_rdup)}
  531. .else
  532. static $t rdup_$t();
  533. .endif
  534. .endforeach
  535. .foreach t $(need_rdup_list)
  536. .if ${index $t $(want_rdup_list)}
  537. .else
  538. static $t_list rdup_$t_list();
  539. .endif
  540. .endforeach
  541.  
  542. .foreach t $(need_rdup)
  543. .if ${index $t $(want_rdup)}
  544. .set stat
  545. .else
  546. .set stat "static "
  547. .endif
  548. /* Recursively duplicate instance `e' of type `$t'
  549.  * and all elements in it.
  550.  */
  551. $(stat)$t rdup_$t( e )
  552.  $t e;
  553. {
  554. .if ${len ${telmlist $t}}
  555. .foreach e ${telmlist $t}
  556. .if ${eq list ${ttypeclass $t $e}}
  557.     ${ttypename $t $e}_list i_$e;
  558. .else
  559.     ${ttypename $t $e} i_$e;
  560. .endif
  561. .endforeach
  562.  
  563.     if( e == $tNIL ) return $tNIL;
  564. .foreach e ${telmlist $t}
  565. .if ${eq list ${ttypeclass $t $e}}
  566.     i_$e = rdup_${ttypename $t $e}_list( e->$e );
  567. .else
  568.     i_$e = rdup_${ttypename $t $e}( e->$e );
  569. .endif
  570. .endforeach
  571.     return new_$t( ${seplist ", " ${prefix "i_" ${telmlist $t}}} );
  572. .else
  573.     if( e == $tNIL ) return $tNIL;
  574.     switch( e->tag ){
  575. .foreach c ${conslist $t}
  576.         case TAG$c:
  577.         {
  578. .foreach e ${celmlist $t $c}
  579. .if ${eq list ${ctypeclass $t $c $e}}
  580.             ${ctypename $t $c $e}_list i_$e;
  581. .else
  582.             ${ctypename $t $c $e} i_$e;
  583. .endif
  584. .endforeach
  585.  
  586. .foreach e ${celmlist $t $c}
  587. .if ${eq list ${ctypeclass $t $c $e}}
  588.             i_$e = rdup_${ctypename $t $c $e}_list( (($c) e)->$e );
  589. .else
  590.             i_$e = rdup_${ctypename $t $c $e}( (($c) e)->$e );
  591. .endif
  592. .endforeach
  593.             return new_$c( ${seplist ", " ${prefix "i_" ${celmlist $t $c}}} );
  594.         }
  595.  
  596. .endforeach
  597.         default:
  598.             FATALTAG( e->tag );
  599.     }
  600.     return $tNIL;
  601. .endif
  602. }
  603.  
  604. .endforeach
  605. .foreach t $(need_rdup_list)
  606. .if ${index $t $(want_rdup_list)}
  607. .set stat
  608. .else
  609. .set stat "static "
  610. .endif
  611. /* recursively duplicate an instance of a `$t' list */
  612. $(stat)$t_list rdup_$t_list( tm_e )
  613.  $t_list tm_e;
  614. {
  615.     $t_list new;
  616.  
  617.     if( tm_e == $t_listNIL ) return $t_listNIL;
  618.     new = rdup_$t( tm_e );
  619.     new->next = rdup_$t_list( tm_e->next );
  620.     return new;
  621. }
  622.  
  623. .endforeach
  624. /*********************************************************
  625.  *    cmp_<type> and cmp_<type>_list routines            *
  626.  *********************************************************/
  627. .. Forward declarations
  628. .foreach t $(need_cmp)
  629. .if ${index $t $(want_cmp)}
  630. .else
  631. static int cmp_$t();
  632. .endif
  633. .endforeach
  634. .foreach t $(need_cmp_list)
  635. .if ${index $t $(want_cmp_list)}
  636. .else
  637. static int cmp_$t_list();
  638. .endif
  639. .endforeach
  640.  
  641. .foreach t $(need_cmp)
  642. .if ${index $t $(want_cmp)}
  643. .set stat
  644. .else
  645. .set stat "static "
  646. .endif
  647. .if ${len ${telmlist $t}}
  648. .. cmp tuple
  649. /* Compare two $t tuples. */
  650. $(stat)int cmp_$t( a, b )
  651.  register $t a;
  652.  register $t b;
  653. {
  654.     register int res;
  655.  
  656.     res = 0;
  657. .set first 1
  658. .foreach ename ${telmlist $t}
  659. .if ${eq list ${ttypeclass $t $(ename)}}
  660. .set tn ${ttypename $t $(ename)}_list
  661. .else
  662. .set tn ${ttypename $t $(ename)}
  663. .endif
  664. .if $(first)
  665. .set first 0
  666. .else
  667.     if( res != 0 ) return res;
  668. .endif
  669.     res = cmp_$(tn)( a->$(ename), b->$(ename) );
  670. .endforeach
  671.     return res;
  672. }
  673.  
  674. .else
  675. .. cmp constructor
  676. /* Compare two $t constructors */
  677. $(stat)int cmp_$t( a, b )
  678.  $t a;
  679.  $t b;
  680. {
  681.     register int res;
  682.  
  683.     res = ((int) a->tag - (int) b->tag);
  684.     if( res != 0 ) return res;
  685.     switch( a->tag )
  686.     {
  687. .foreach c ${conslist $t}
  688.     case TAG$c:
  689. .set first 1
  690. .foreach ename ${celmlist $t $c}
  691. .if ${eq list ${ctypeclass $t $c $(ename)}}
  692. .set tn ${ctypename $t $c $(ename)}_list
  693. .else
  694. .set tn ${ctypename $t $c $(ename)}
  695. .endif
  696. .if $(first)
  697. .set first 0
  698. .else
  699.         if( res != 0 ) break;
  700. .endif
  701.         res = cmp_$(tn)( (($c) a)->$(ename), (($c) b)->$(ename) );
  702. .endforeach
  703.         break;
  704.  
  705. .endforeach
  706.         default:
  707.         FATALTAG( a->tag );
  708.     }
  709.     return res;
  710. }
  711.  
  712. .endif
  713. .endforeach
  714. .foreach t $(need_cmp_list)
  715. .if ${index $t $(want_cmp_list)}
  716. .set stat
  717. .else
  718. .set stat "static "
  719. .endif
  720. /* Compare two $t lists. */
  721. $(stat)int cmp_$t_list( a, b )
  722.  register $t_list a;
  723.  register $t_list b;
  724. {
  725.     register int res;
  726.  
  727.     while( (a!=$tNIL) || (b!=$tNIL) ){
  728.     if( a==$tNIL ) return -1;
  729.     if( b==$tNIL ) return 1;
  730.     res = cmp_$t( a, b );
  731.     if( res != 0 ) return res;
  732.     a = a->next;
  733.     b = b->next;
  734.     }
  735.     return 0;
  736. }
  737.  
  738. .endforeach
  739. /*********************************************************
  740.  *    fscan_<type> and fscan_<type>_list routines        *
  741.  *********************************************************/
  742.  
  743. .. Forward declarations
  744. .foreach t $(need_fscan)
  745. .if ${index $t $(want_fscan)}
  746. .else
  747. static int fscan_$t();
  748. .endif
  749. .endforeach
  750. .foreach t $(need_fscan_list)
  751. .if ${index $t $(want_fscan_list)}
  752. .else
  753. static int fscan_$t_list();
  754. .endif
  755. .endforeach
  756.  
  757. .foreach t $(need_fscan)
  758. .if ${index $t $(want_fscan)}
  759. .set stat
  760. .else
  761. .set stat "static "
  762. .endif
  763. .if ${len ${telmlist $t}}
  764. /* Read a tuple of type '$t' from file 'f',
  765.    and create an instance of a C structure for it.
  766.    Set '*p' to this new structure.
  767.  */
  768. $(stat)int fscan_$t( f, p )
  769.  FILE *f;
  770.  $t *p;
  771. {
  772. .foreach ename ${telmlist $t}
  773. .if ${eq list ${ttypeclass $t $(ename)}}
  774. .set tn ${ttypename $t $(ename)}_list
  775. .else
  776. .set tn ${ttypename $t $(ename)}
  777. .endif
  778.     $(tn) l_$(ename);
  779. .endforeach
  780.     register short int err;
  781.  
  782. .foreach ename ${telmlist $t}
  783. .if ${eq list ${ttypeclass $t $(ename)}}
  784. .set tn ${ttypename $t $(ename)}_list
  785. .else
  786. .set tn ${ttypename $t $(ename)}
  787. .endif
  788.     l_$(ename)=$(tn)NIL;
  789. .endforeach
  790.     *p = $tNIL;
  791.     err = tmfneedc( f, '(' );
  792.     if(err) return(1);
  793. .set first 1
  794. .foreach ename ${telmlist $t}
  795. .if $(first)
  796. .set first 0
  797. .else
  798.     if(!err) err = tmfneedc( f, ',' );
  799. .endif
  800. .if ${eq list ${ttypeclass $t $(ename)}}
  801. .set tn ${ttypename $t $(ename)}_list
  802. .else
  803. .set tn ${ttypename $t $(ename)}
  804. .endif
  805.     if(!err) err = fscan_$(tn)( f, &l_$(ename) );
  806. .endforeach
  807.     *p = new_$t( ${seplist ", " ${prefix " l_" ${telmlist $t}}} );
  808.     if(err) return(1);
  809.     return tmfneedc( f, ')' );
  810. }
  811. .else
  812. .foreach c ${conslist $t}
  813. /* Constructor name '$c' was encountered in file 'f',
  814.    read remainder of constructor, and create an instance of
  815.    a C structure for it. set '*p' to this new structure.
  816.  */
  817. static int fscan_$c( f, p )
  818.  FILE *f;
  819.  $t *p;
  820. {
  821. .foreach ename ${celmlist $t $c}
  822. .if ${eq list ${ctypeclass $t $c $(ename)}}
  823. .set tn ${ctypename $t $c $(ename)}_list
  824. .else
  825. .set tn ${ctypename $t $c $(ename)}
  826. .endif
  827.     $(tn) l_$(ename);
  828. .endforeach
  829.     register short int err = 0;
  830.  
  831. .foreach ename ${celmlist $t $c}
  832. .if ${eq list ${ctypeclass $t $c $(ename)}}
  833. .set tn ${ctypename $t $c $(ename)}_list
  834. .else
  835. .set tn ${ctypename $t $c $(ename)}
  836. .endif
  837.     l_$(ename)=$(tn)NIL;
  838.     if(!err) err = fscan_$(tn)( f, &l_$(ename) );
  839. .endforeach
  840.     *p = new_$c( ${seplist ", " ${prefix " l_" ${celmlist $t $c}}} );
  841.     return(err);
  842. }
  843.  
  844. .endforeach
  845. /* Read an instance of a datastructure of type $t.
  846.    from file 'f' and allocate space for it. Set the pointer 'p' to
  847.    point to that structure.
  848.  */
  849. $(stat)int fscan_$t( f, p )
  850.  FILE *f;
  851.  $t *p;
  852. {
  853.     int n;
  854.     char word[WORDBUFSIZE];
  855.     register short int err = 0;
  856.  
  857.     *p = $tNIL;
  858.     n = fscanopenbrac( f );
  859.     if( fscancons( f, word ) ) return 1;
  860. .set els
  861. .foreach c ${conslist $t}
  862.     $(els)if( strcmp( word, "$c" ) == 0 ){
  863.         err = fscan_$c( f, p );
  864.     }
  865. .set els "else "
  866. .endforeach
  867.     else {
  868.         (void) sprintf( tmerrmsg, tm_badcons, "$t", word );
  869.         return 1;
  870.     }
  871.     if(err) return(1);
  872.     return fscanclosebrac( f, n );
  873. }
  874.  
  875. .endif
  876. .endforeach
  877. .foreach t $(need_fscan_list)
  878. .if ${index $t $(want_fscan_list)}
  879. .set stat
  880. .else
  881. .set stat "static "
  882. .endif
  883. /* Read an instance of a list of datastructure of type $t.
  884.    from file 'f' and allocate space for it. Set the pointer 'p' to
  885.    point to that structure.
  886.  */
  887. $(stat)int fscan_$t_list( f, p )
  888.  FILE *f;
  889.  $t_list *p;
  890. {
  891.     int n;
  892.     register int c;
  893.     $t new;
  894.     register short int err = 0;
  895.  
  896.     *p = $tNIL;
  897.     n = fscanopenbrac( f );
  898.     if( tmfneedc( f, '[' ) ) return 1;
  899.     if( fscanspace( f ) ) return 1;
  900.     c = getc( f );
  901.     if( c == EOF ){
  902.         (void) strcpy( tmerrmsg, tm_badeof );
  903.         return 1;
  904.     }
  905.     if( c == ']' ) return 0;
  906.     ungetc( c, f );
  907.     while( 1 ){
  908.         err = fscan_$t( f, &new );
  909.         *p = app_$t_list( *p, new );
  910.         if(err) return 1;
  911.         if( fscanspace( f ) ) return 1;
  912.         c = getc( f );
  913.         if( c == EOF ){
  914.             (void) strcpy( tmerrmsg, tm_badeof );
  915.             return 1;
  916.         }
  917.         if( c != ',' ){
  918.             ungetc( c, f );
  919.             break;
  920.         }
  921.     }
  922.     if( tmfneedc( f, ']' ) ) return 1;
  923.     return fscanclosebrac( f, n );
  924. }
  925.  
  926. .endforeach
  927. .if ${index stat_$(basename) $(need_misc)}
  928. /*********************************************************
  929.  *    Statistics printing routines                       *
  930.  *********************************************************/
  931.  
  932. .if ${index stat_$(basename) $(want_misc)}
  933. .set stat
  934. .else
  935. .set stat "static "
  936. .endif
  937. /* give statistics */
  938. void stat_$(basename)( f )
  939.  FILE *f;
  940. {
  941. #ifdef STAT
  942. .foreach t $(need_stat)
  943. .if ${len ${telmlist $t}}
  944.     fprintf(f,tm_allocfreed,"$t",newcnt_$t,frecnt_$t,((newcnt_$t==frecnt_$t)? "": "<-"));
  945. .else
  946. .foreach c ${conslist $t}
  947.     fprintf(f,tm_allocfreed,"$c",newcnt_$c,frecnt_$c,((newcnt_$c==frecnt_$c)? "": "<-"));
  948. .endforeach
  949. .endif
  950. .endforeach
  951. #else
  952.     f = f; /* to prevent 'f unused' from compiler and lint */
  953. #endif
  954. }
  955.  
  956. .endif
  957. /* ---- end of ${tplfilename} ---- */
  958.